home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Aminet 8
/
Aminet 8 (1995)(GTI - Schatztruhe)[!][Oct 1995].iso
/
Aminet
/
comm
/
fido
/
Rock_1_5.lha
/
ROCK
/
rock.rexx
< prev
next >
Wrap
OS/2 REXX Batch file
|
1995-05-12
|
4KB
|
203 lines
/*
Rock v1.5 - Fidonet mailer for point systems
This file is modified from jaz.f, Copyright (c) 1994 Robert Williamson
Modifications for Rock are Copyright (C) 1995 Jean-Marc Xiume'
This software is distributed under the terms of the
GNU General Public License. Read "license.doc" for more details.
********************** Outbound scanner for XferQ **********************
*/
LF='A'x
CR='D'x
qout=1
options results
options failat 99
Parse upper arg od ha ra .
call random(,,time(s))
OBJ=XfqGetAddress(ra)
if XfqSessionUp(OBJ) then do
if ~XfqHoldMailer(OBJ) then do
drop XFQERRORCODE XFQERRORMSG
v=XfqDropObject(OBJ)
v=XfqClose()
exit
end
end
else do
Say 'Site 'ra' not online, exiting rock.rexx'
drop XFQERRORCODE XFQERRORMSG
v=XfqDropObject(OBJ)
v=XfqClose()
return 1
end
id=pragma('ID')
xpr.H=0
xpr.C=50
xpr.D=30
xpr.N=0
xpr.F=0
xpr.O=0
parse var ra rd "#" rz ":" rn "/" rf "." rp .
v=sflos()
v=souts()
cleanup:
v=XfqReleaseMailer(OBJ)
v=XfqDropObject(OBJ)
v=XfqClose()
v=delete('T:f'id)
v=delete('T:o'id)
exit 0
sFLOS:
Address COMMAND 'LIST >T:f'id od||rz'.'rn'.'rf'.'rp'.?LO quick nohead'
if word(statef("T:f"id),2)=0 then return 0
if ~open('fl',"T:f"id,'R') then return 0
i=0
do while ~eof('fl')
L=Upper(strip(space(ReadLn('fl'),1),'B'))
if L="" then iterate
i=i+1
ff.i=L
parse var L fln.i.zone"."fln.i.net"."fln.i.node"."fln.i.point"."junk
ft=left(junk,1)
if pos(ft,'H C D N F')>0 then ff.i.pr=xpr.ft
else Iterate
end
v=close('fl')
if i=0 then return 0
ff.nn=i
do an=1 until an=ff.nn
err=0
fnm=upper(od||ff.an)
if ~exists(fnm) then err=1
else if ~Open('ff',fnm,'R') then err=1
if ~err then do
say 'Scanning 'fnm
do while ~eof('ff')
L=""
C=readch('ff',1)
do while (C~=CR & C~=LF & ~eof('ff'))
L=L||C
C=readch('ff',1)
end
if L="" then iterate
L=upper(L)
flg=20
dp=left(L,1)
if dp="#" then do
flg=22
L=delstr(L,1,1)
end
else if dp="^"|dp="-" then do
flg=21
L=delstr(L,1,1)
end
else if dp="@" then do
flg=20
L=delstr(L,1,1)
end
if index(L,":")=0 then L=od||L
if ~exists(L) then do
say 'Cannot find 'L
iterate
end
parse var L x '.' x '.' x '.' x '.' ex
drop x
if ex="" then do
if right(L,3)="TIC" then flg=21
as=gfn(L)
p=ff.an.pr
end
else do
tx=upper(left(ex,2))
if datatype(right(ex,1),'n')&(tx="MO"|tx="TU"|tx="WE"|tx="TH"|tx="FR"|tx="SA"|tx="SU") then do
/* parse var ha hd "#" hz ":" hn "/" hf "." hp
as=UPPER(d2x(65536+hn-fln.an.net,4)||d2x(65536+hf-fln.an.node,4)||'.'ex) */
as=right(compress(time(),":"),4)||d2x(random(0,255)+256*random(0,255),4)||'.'ex
flg=21
p=ff.an.pr
end
else do
as=gfn(L)
flg=20
p=ff.an.pr
end
end
drop ex
QUERY.XQ_NAME=L
QUERY.XQ_SITE=OBJ
wn=NULL
wn=XfqFindWork(QUERY)
if wn=NULL then do
say 'Sending:'L' ['as'] :'ra' Disp:'flg' Pri:'p
v=XfqAddWorkQuick(ra,L,as,p,flg)
end
else v=XfqUnlockWork(wn)
end
v=close('ff')
end
if wn~=NULL then v=XfqDropObject(wn)
end
return 0
sOUTS:
Address COMMAND 'LIST >T:o'id od||rz'.'rn'.'rf'.'rp'.?UT quick nohead'
if word(statef("T:o"id),2)=0 then return 0
if ~open('o',"T:o"id,'R') then return 0
do while ~eof('o')
of=upper(readln('o'))
if of="" then iterate
parse var of x '.' x '.' x '.' x '.' ex
drop x
if ~qout & ex="OUT" then Iterate
xt=left(ex,1)
if pos(xt,'H C D N O')>0 then p=xpr.xt
else Iterate
file=od||of
as=left(date(),2)||compress(time(),":")||".PKT"
flg=21
QUERY.XQ_NAME=file
QUERY.XQ_SITE=OBJ
wn=NULL
wn=XfqFindWork(QUERY)
if wn=NULL then do
say 'Sending:'file' ['as'] :'ra' Disp:'flg' Pri:'p
v=XfqAddWorkQuick(ra,file,as,p,flg)
end
else v=XfqUnlockWork(wn)
if wn~=NULL then v=XfqDropObject(wn)
end
v=close('o')
return 0
gfn: procedure
if LastPos('/',arg(1))~=0 then return SubStr(arg(1),LastPos('/',arg(1))+1)
else if LastPos(':',arg(1))~=0 then return SubStr(arg(1),LastPos(':',arg(1))+1)
else return arg(1)